home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / select.tcl.z / select.tcl
Text File  |  2002-07-08  |  5KB  |  161 lines
  1. # select.tcl
  2. #
  3. # Keystroke bindings to select for message or folder
  4. #
  5. # Copyright (c) 1993 Xerox Corporation.
  6. # Use and copying of this software and preparation of derivative works based
  7. # upon this software are permitted. Any distribution of this software or
  8. # derivative works must comply with all applicable United States export
  9. # control laws. This software is made available AS IS, and Xerox Corporation
  10. # makes no warranty about the software, its performance or its conformity to
  11. # any specification.
  12.  
  13. # Select_Bindings creates bindings on the message and ftoc windows
  14. # that in turn warp focus to the Status window for folder & message selection
  15. proc Select_Bindings { w } {
  16.     global select
  17.     set select(sel) {}
  18.     set select(prompt) {}
  19.     foreach digit {0 1 2 3 4 5 6 7 8 9} {
  20.     bind $w <Key-$digit> {SelectDigit %W %A}
  21.     }
  22.     bind $w <Key-plus> {SelectPlus %W}
  23.     set select(toggle) { Change Target }
  24. }
  25. proc SelectPlus { w } {
  26.     global select
  27.     $select(entry) configure -state normal
  28.     focus $select(entry)
  29.     set select(sel) {}
  30.     set select(prompt) "[lindex $select(toggle) 0] Folder:"
  31.     set select(folder) 1
  32.     Exmh_Status "$select(prompt) "
  33. }
  34. proc SelectDigit {w digit} {
  35.     global select
  36.     $select(entry) configure -state normal
  37.     focus $select(entry)
  38.     set select(sel) $digit
  39.     set select(prompt) Msg:
  40.     catch {unset select(folder)}
  41.     Exmh_Status "Select Msg: $select(sel)"
  42.     Msg_Change $select(sel) noshow
  43. }
  44.  
  45. # These are the bindings on the status entry widget
  46. proc Select_EntryBind { w } {
  47.     global select
  48.     set select(entry) $w
  49.     bindtags $w [list $w Entry]
  50.     bind $w <Any-Key>    {SelectTypein %W %A}
  51.     bind $w <Key-plus>    {SelectToggle %W }
  52.     bind $w <space>    {SelectComplete %W}
  53.     bind $w <Tab>    {SelectComplete %W}
  54.     bind $w <Return>    {SelectReturn %W}
  55.     bind $w <BackSpace>    {SelectBackSpace %W}
  56.     bind $w <Control-h>    {SelectBackSpace %W}
  57.     bind $w <Delete>    {SelectBackSpace %W}
  58.     bind $w <Control-c>    {SelectCancel %W}
  59.     bind $w <Control-g>    {SelectCancel %W}
  60.     bind $w <Control-u>    {SelectClear %W}
  61. }
  62. proc SelectTypein {w {a {}}} {
  63.     global select
  64.     if {$a == {}} {
  65.     return
  66.     }
  67.     if [info exists select(match)] {
  68.     set select(sel) $select(match)
  69.     unset select(match)
  70.     catch {unset select(allfolders)}
  71.     }
  72.     append select(sel) $a
  73.     Exmh_Status "$select(prompt) $select(sel)"
  74.     if ![info exists select(folder)] {
  75.     Msg_Change $select(sel) noshow
  76.     }
  77. }
  78. proc SelectBackSpace { w } {
  79.     global select
  80.     if [info exists select(match)] {
  81.     set select(sel) $select(match)
  82.     unset select(match)
  83.     catch {unset select(allfolders)}
  84.     }
  85.     set select(sel) [string range $select(sel) 0 [expr [string length $select(sel)]-2]]
  86.     Exmh_Status "$select(prompt) $select(sel)"
  87.     if ![info exists select(folder)] {
  88.     Msg_Change $select(sel) noshow
  89.     }
  90. }
  91. proc SelectToggle {w} {
  92.     global select
  93.     if [info exists select(folder)] {
  94.     set select(toggle) [list [lindex $select(toggle) 1] [lindex $select(toggle) 0]]
  95.     set select(prompt) "[lindex $select(toggle) 0] Folder:"
  96.     } else {
  97.     catch {
  98.         incr select(sel)
  99.         Msg_Change $select(sel) noshow
  100.     }
  101.     }
  102.     Exmh_Status "$select(prompt) $select(sel)"
  103. }
  104. proc SelectComplete { w } {
  105.     global select
  106.     if [info exists select(folder)] {
  107.     global flist
  108.     if ![info exists select(allfolders)] {
  109.         set select(allfolders) $flist(allfolders)
  110.     }
  111.     set ix 0
  112.     foreach f $select(allfolders) {
  113.         incr ix
  114.         if [string match $select(sel)* $f] {
  115.         set select(allfolders) [lrange $select(allfolders) $ix end]
  116.         if {$select(allfolders) == {}} {
  117.             unset select(allfolders)
  118.         }
  119.         set select(match) $f
  120.         Exmh_Status "$select(prompt) $f"
  121.         return
  122.         }
  123.     }
  124.     unset select(allfolders)
  125.     catch {unset select(match)}
  126.     Exmh_Status "$select(prompt) $select(sel)"
  127.     }
  128. }
  129. proc SelectReturn { w } {
  130.     global select
  131.     if [info exists select(folder)] {
  132.     if [info exists select(match)] {
  133.         set select(sel) $select(match)
  134.         unset select(match)
  135.     }
  136.     if [string length $select(sel)] {
  137.         Folder_[lindex $select(toggle) 0] $select(sel)
  138.     }
  139.     unset select(folder)
  140.     catch {unset select(allfolders)}
  141.     } else {
  142.     Msg_Change $select(sel) show
  143.     }
  144.     $select(entry) configure -state disabled
  145.     Exmh_Focus
  146. }
  147. proc SelectCancel { w } {
  148.     global select
  149.     if [info exists select(folder)] {
  150.     set select(toggle) { Change Target }
  151.     unset select(folder)
  152.     }
  153.     $select(entry) configure -state disabled
  154.     Exmh_Focus
  155. }
  156. proc SelectClear { w } {
  157.     global select
  158.     set select(sel) {}
  159.     Exmh_Status "$select(prompt) $select(sel)"
  160. }
  161.